Monster Media 1996 #15

home *** CD-ROM | disk | FTP | other *** search

/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / tbbs / prgsourc.zip / EVENTS.ZIP / EVENTM1.PRG < prev next >

Wrap

Text File | 1996-04-24 | 44KB | 1,075 lines

******************************************************************* * FILES * Homepath()\DAY\XXXXXX.DAY = Two weeks of daily events * Homepath()\DAY\XXXDAY.WK = Weekly events by day of week * Homepath()\DAY\XX.MON = Monthly events by day of month * Homepath()\DAY\XXXXXX.DM = Monthly events by X day of X day-of-week * XXXXXX.RVW = Past week's reviews, inc. events, names, review * Homepath()\ARC\XXXXXX.ZIP = Archived RVW files, minus names * Homepath()\POST\XXXXXX.PST = ANSI Posters * Homepath()\LST\XXXXXX.LST = Shedules * USER.USR = Config & Auth file, all users ******************************************************************* * VARIABLES * a = add[] counter * c = column * i = temporary * j = temporary * k = key input * m = menu[] counter * p = page of tBoard * r = row * s = srch[] counter * u = setup[] counter * v = view[] counter * x = local counter * y = local counter * z = file process return * buf = max buffer size * line = line read from file * sub = .SUB file * day = .DAY file * ustr = User String, subject configuration * sstr = Subject String, subject configuration ******************************************************************* * DBF FIELDS * sth,eth = start/end time(hour) ca,cu,cc = cost: adult,under 12, child * stm,etm = start/end minute sap,eap = start/end a.m./p.m. * loc,cty,stat,phn = location, city, state, phone number * ev,dsc1,dsc2 = event name and two description line ******************************************************************* * PROCEDURES * BoxW: White box with optional shadow, <ANY KEY> * clrB: Clears pBoxes to blue * pBox: Pick boxes (pull-down menus) * Screen: Pull-down menus ******************************************************************* SET FORMAT TO fscr NOCLEAR SET INTENSITY OFF SET ESCAPE OFF ok = .T. && Initialize Variables STORE " " TO k,line STORE 0 TO s,a,v,u,m buf = fMaxLen() && Allocate file buffers IF buf > 4096 buf = 2048 ELSE IF buf > 2048 buf = 1024 ELSE buf = 256 ENDIF ENDIF FOPEN usr USER.USR 10 buf FLFIND usr z UName() 0 IF z < 1 FCLOSE usr ustr = Replicate("X",130) dstr = "TWM" line = ustr + dstr + Chr(13) + Chr(10) FOPEN usr USER.USR 11 buf FLWRITE usr z line FCLOSE usr ELSE FLREAD usr z line FCLOSE usr line = CRTrim(line) ustr = SubStr(line,31,130) dstr = SubStr(line,131,3) ENDIF sstr = ustr tstr = dstr ***************************************************************** DECLARE menu[6] && Bar Menu (m) menu[1] = " View " menu[2] = " Find " menu[3] = " Add/Cancel " menu[4] = " Setup " menu[5] = " Help " menu[6] = " Quit " DECLARE view[3] && View menu (v) view[1] = " Events " view[2] = " Slideshow " view[3] = " Reviews " DECLARE srch[5] && Search menu (s) srch[1] = " Poster " srch[2] = " Event " srch[3] = " Schedule " srch[4] = " Review " srch[5] = " Archive " DECLARE add[4] && Add menu (a) add[1] = " Add Event ... " add[2] = " Cancel Event ... " add[3] = " Upload Schedule " add[4] = " Upload Poster " DECLARE setup[6] && Setup menu (u) setup[1] = " Subjects ... " setup[2] = " Locations ... " setup[3] = " Today & Tomorrow " setup[4] = " This Week " setup[5] = " This Month " setup[6] = " Select Date ... " ***************************************************************** DO Screen m = 4 y = 46 u = 1 DO pBox WITH m DO Msg WITH 41 DO WHILE .T. SET COLOR TO B/B @ 22,0 GET k DO WHILE .T. READ DO CASE CASE LastKey() = 19 && <Lt Arrow> v = 1 s = 1 a = 1 u = 1 SET COLOR TO N/W @ 0,y SAY menu[m] DO clrB WITH m IF m = 1 m = 6 ELSE m = m - 1 ENDIF DO CASE CASE m = 1 y = 4 CASE m = 2 y = 17 CASE m = 3 y = 29 CASE m = 4 y = 46 CASE m = 5 y = 59 CASE m = 6 && Quit y = 71 ENDCASE IF m < 5 DO pBox WITH m ENDIF DO Msg WITH (m*10)+1 SET COLOR TO W/N @ 0,y SAY menu[m] CASE LastKey() = 4 && <Rt Arrow> v = 1 s = 1 a = 1 u = 1 SET COLOR TO N/W @ 0,y SAY menu[m] DO clrB WITH m IF m = 6 m = 1 ELSE m = m + 1 ENDIF DO CASE CASE m = 1 y = 4 CASE m = 2 y = 17 CASE m = 3 y = 29 CASE m = 4 y = 46 CASE m = 5 y = 59 CASE m = 6 && Quit y = 71 ENDCASE IF m < 5 DO pBox WITH m ENDIF DO Msg WITH (m*10)+1 SET COLOR TO W/N @ 0,y SAY menu[m] CASE LastKey() = 5 && <Up Arrow> SET COLOR TO N/W DO CASE CASE m = 1 && View @ v+1,4 SAY view[v] IF v = 1 v = 3 ELSE v = v - 1 ENDIF DO Msg WITH 10+v SET COLOR TO W+/N @ v+1,4 SAY view[v] CASE m = 2 && Search @ s+1,16 SAY srch[s] IF s = 1 s = 5 ELSE s = s - 1 ENDIF DO Msg WITH 20+s SET COLOR TO W+/N @ s+1,16 SAY srch[s] CASE m = 3 && Add/Cancel @ a+1,24 SAY add[a] IF a = 1 a = 4 ELSE a = a - 1 ENDIF DO Msg WITH 30+a SET COLOR TO W+/N @ a+1,24 SAY add[a] CASE m = 4 && Setup @ u+1,35 SAY setup[u] IF u = 1 u = 6 ELSE u = u - 1 ENDIF DO Msg WITH 40+u SET COLOR TO W+/N @ u+1,35 SAY setup[u] ENDCASE CASE LastKey() = 24 && <Dn Arrow> SET COLOR TO N/W DO CASE CASE m = 1 && View @ v+1,4 SAY view[v] IF v = 3 v = 1 ELSE v = v + 1 ENDIF DO Msg WITH 10+v SET COLOR TO W+/N @ v+1,4 SAY view[v] CASE m = 2 && Find @ s+1,16 SAY srch[s] IF s = 5 s = 1 ELSE s = s + 1 ENDIF DO Msg WITH 20+s SET COLOR TO W+/N @ s+1,16 SAY srch[s] CASE m = 3 && Add/Cancel @ a+1,24 SAY add[a] IF a = 4 a = 1 ELSE a = a + 1 ENDIF DO Msg WITH 30+a SET COLOR TO W+/N @ a+1,24 SAY add[a] CASE m = 4 && Setup @ u+1,35 SAY setup[u] IF u = 6 u = 1 ELSE u = u + 1 ENDIF DO Msg WITH 40+u SET COLOR TO W+/N @ u+1,35 SAY setup[u] ENDCASE CASE LastKey() = 13 && <Enter> DO CASE CASE m = 1 && View DO CASE CASE v = 1 && Events SET COLOR TO B/B @ 1,3 CLEAR TO 6,16 DO CASE CASE "M" $ tstr n = 30 CASE "W" $ tstr n = 7 OTHERWISE n = 2 ENDCASE DO BoxW WITH 2,4,18,55,"s" @ 5,6 SAY "When:" @ 7,6 SAY "What:" @ 12,6 SAY "Where:" @ 14,6 SAY "Adults:" @ 15,6 SAY "Und. 12: Children:" @ 17,6 SAY "Contact:" SET COLOR TO GR+/B @ 3,5 SAY " EVENTS FOR DAY: " nx = 1 && day (nx = 1 = today) bx = 1 && byte count xx = 1 && exit code for Popup (0 = bof,1 = ok, 2 = not in str, 3 = eof) DO Popup WITH nx,bx,xx k = " " DO WHILE .T. READ DO CASE CASE LastKey() = 5 && Up DO WHILE .T. DO CASE CASE bx <= 289 .AND. nx = 1 EXIT CASE bx <= 289 nx = nx - 1 DO Popup WITH nx,0,xx DO CASE CASE xx = 0 LOOP CASE xx = 2 bx = bx - 596 OTHERWISE EXIT ENDCASE OTHERWISE bx = bx - 288 DO Popup WITH nx,bx,xx DO CASE CASE xx = 0 LOOP CASE xx = 2 bx = bx - 596 OTHERWISE EXIT ENDCASE ENDCASE ENDDO CASE LastKey() = 24 && Down DO WHILE .T. DO CASE CASE xx = 3 .AND. nx = n EXIT CASE xx = 3 && (0 = bof,1 = ok, 2 = not in str, 3 = eof) nx = nx + 1 DO Popup WITH nx,1,xx DO CASE CASE xx = 3 LOOP CASE xx = 2 bx = bx + 288 OTHERWISE EXIT ENDCASE OTHERWISE bx = bx - 288 DO Popup WITH nx,bx,xx DO CASE CASE xx = 0 LOOP CASE xx = 2 bx = bx - 596 OTHERWISE EXIT ENDCASE ENDCASE ENDDO CASE LastKey() = 27 && Esc EXIT ENDCASE ENDDO DO pBox WITH 1 CASE v = 2 && Slideshow SET COLOR TO W/N @ 3,4 SAY " Slideshow " DO pBox WITH 1 SET COLOR TO W+/N @ 3,4 SAY " Slideshow " CASE v = 3 && Reviews SET COLOR TO W/N @ 4,4 SAY " Reviews " DO pBox WITH 1 SET COLOR TO W+/N @ 4,4 SAY " Reviews " ENDCASE CASE m = 2 && Search DO CASE SET COLOR TO W+/B CASE s = 1 && " Poster " CASE s = 2 && " Event " CASE s = 3 && " Schedule " CASE s = 4 && " Review " CASE s = 5 && " Archive " ENDCASE CASE m = 3 DO CASE CASE a = 1 && " Add Event ... " DO ClrB WITH 3 DO BoxW WITH 8,30,14,50,"s" SET COLOR TO GR+/B @ 9,31 SAY " Add Event " SET COLOR TO N/W @ 11,32 SAY "( ) Weekly Event" @ 12,32 SAY "( ) Monthly Event" @ 13,32 SAY "( ) Special Event" DO Msg WITH 2 ae = 3 DO Ckae WITH ae k = " " r = 13 DO WHILE .T. READ DO CASE CASE LastKey() = 13 EXIT CASE LastKey() = 5 && Up Arrow IF r = 11 r = 13 ELSE r = r - 1 ENDIF ae = r - 10 DO Ckae WITH ae CASE LastKey() = 24 && Dn Arrow IF r = 13 r = 11 ELSE r = r + 1 ENDIF ae = r - 10 DO Ckae WITH ae ENDCASE ENDDO SET COLOR TO B/B @ 8,30 CLEAR TO 15,51 SET COLOR TO W+/B && Remove DO CASE CASE ae = 1 USE week DO NewDbf SET COLOR TO GR+/B @ 4,11 SAY " Weekly Event " SET COLOR TO N/W @ 8,12 SAY "Day of week Event happens:" SET FORMAT TO fweek NOCLEAR CASE ae = 2 USE month DO NewDbf SET COLOR TO GR+/B @ 4,11 SAY " Monthly Event " SET COLOR TO N/W @ 8,12 SAY "Day of week: No. of [week or day] in month:" SET FORMAT TO fmon NOCLEAR CASE ae = 3 USE newev DO NewDbf SET COLOR TO GR+/B @ 4,11 SAY " Special Event " SET COLOR TO N/W @ 8,12 SAY "Start Date: End Date: " SET FORMAT TO fadd NOCLEAR ENDCASE DO WHILE .T. READ DO CASE CASE LastKey() = 23 && Ctrl-End ok = .T. EXIT CASE LastKey() = 27 && Esc ok = .F. EXIT CASE LastKey() = 63 && ? Help LOOP ENDCASE ENDDO SET FORMAT TO fscr NOCLEAR SET COLOR TO B/B @ 3,10 CLEAR TO 20,71,"s" IF ok p = 0 DO BoxW WITH 3,7,19,69,"s" SET COLOR TO GR+/B @ 4,8 SAY " TOPIC BOARD Page " x = 6 SET COLOR TO N/W DO Msg WITH 3 DO WHILE x <= 18 @ x,9 SAY "[ ] [ ]" x = x + 1 ENDDO sstr = Replicate(Chr(32),130) DECLARE Sarray[26] DO tBoard WITH p,sstr SET COLOR TO W+/B @ 6,9 SAY "[" + SubStr(sstr,(p*26 + 1),1) + "] " + Sarray[1] SET COLOR TO W+/W r = 6 c = 10 ss = 0 x = 1 sa = 1 DO WHILE .T. READ SET COLOR TO N/W DO CASE CASE LastKey() = 5 && Up DO CASE CASE r > 6 @ r,c-1 SAY "[" + SubStr(sstr,x,1) + "] " + Sarray[sa] r = r - 1 sa = sa - 1 CASE r = 6 .AND. c = 10 .AND. p = 0 LOOP CASE r = 6 .AND. c = 10 .AND. p > 0 p = p - 1 @ 6,9 SAY "[ ] " DO tBoard WITH p,sstr r = 18 c = 40 ss = 1 sa = 26 CASE r = 6 .AND. c = 40 @ 6,39 SAY "[" + SubStr(sstr,x,1) + "] " + Sarray[sa] sa = sa - 1 r = 18 c = 10 ss = 0 ENDCASE CASE LastKey() = 3 && Page Dn DO CASE CASE p = 4 @ r,c-1 SAY "[" + SubStr(sstr,x,1) + "] " + Sarray[sa] sa = 26 r = 18 c = 40 CASE p < 4 p = p + 1 DO tBoard WITH p,sstr ENDCASE CASE LastKey() = 18 && Page Up DO CASE CASE p = 0 @ r,c-1 SAY "[" + SubStr(sstr,x,1) + "] " + Sarray[sa] sa = 1 r = 6 c = 10 CASE p > 0 p = p - 1 DO tBoard WITH p,sstr ENDCASE CASE LastKey() = 24 && Down DO CASE CASE r < 18 @ r,c-1 SAY "[" + SubStr(sstr,x,1) + "] " + Sarray[sa] r = r + 1 sa = sa + 1 CASE r = 18 .AND. c = 40 .AND. p = 4 LOOP CASE r = 18 .AND. c = 40 .AND. p < 4 p = p + 1 @ 18,39 SAY "[ ] " DO tBoard WITH p,sstr r = 6 c = 10 ss = 0 sa = 1 CASE r = 18 .AND. c = 10 @ 18,9 SAY "[" + SubStr(sstr,x,1) + "] " + Sarray[sa] sa = sa + 1 r = 6 c = 40 ss = 1 ENDCASE CASE LastKey() = 32 && Space IF SubStr(sstr,x,1) = "X" sstr = Stuff(sstr,x,1,Chr(32)) ELSE sstr = Stuff(sstr,x,1,"X") ENDIF CASE LastKey() = 13 && Enter SET COLOR TO W+/N j = At("X",sstr) IF j = 0 DO BoxW WITH 9,26,13,54,"sa" @ 10,28 SAY "You must mark one subject" k = InKey(40) x = 6 SET COLOR TO N/W @ 6,9 CLEAR TO 18,67 DO WHILE x <= 18 @ x,9 SAY "[ ] [ ]" x = x + 1 ENDDO DO tBoard WITH p,sstr @ 6,10 SAY SubStr(sstr,(p*26 + 1),1) ELSE IF "X" $ SubStr(sstr,j+1) DO BoxW WITH 9,24,13,56,"sa" @ 10,26 SAY "You may mark only one subject" k = InKey(40) x = 6 SET COLOR TO N/W @ 6,9 CLEAR TO 18,67 DO WHILE x <= 18 @ x,9 SAY "[ ] [ ]" x = x + 1 ENDDO DO tBoard WITH p,sstr @ 6,10 SAY SubStr(sstr,(p*26 + 1),1) ELSE DO Msg WITH 3 SET COLOR TO W/N REPLACE owner WITH uName() FOPEN sub SUBJECT.SUB 10 buf FSEEK sub z (j*26) 0 FLREAD sub z line FCLOSE sub line = CRTrim(line) REPLACE sb WITH j REPLACE subject WITH line SET COLOR TO B/B @ 3,7 CLEAR TO 20,71 DO BoxW WITH 5,15,11,65,"s" SET COLOR TO GR+/B @ 6,16 SAY " UPLOAD POSTER " SET COLOR TO N/W @ 8,17 SAY "If you wish to upload a Poster (advertisement)," @ 9,17 SAY "enter the name of the text or ANSI file now." @ 10,17 SAY "[ ]" @ 10,18 GET poster READ IF Updated() f = Homepath() + "POST\" + RTrim(poster) + " /F/D" DOTBBS TYPE 30 OPTDATA f ENDIF DO Screen EXIT ENDIF ENDIF ENDCASE x = (r-5)+(ss*13)+(p*26) SET COLOR TO W+/B @ r,c-1 SAY "[" + SubStr(sstr,x,1) + "] " + Sarray[sa] ENDDO ENDIF RELEASE Sarray DO pBox WITH 3 CASE a = 2 && " Cancel Event ... " CASE a = 3 && " Upload Schedule " CASE a = 4 && " Upload Poster " ENDCASE CASE m = 4 && Setup DO CASE CASE u = 1 && " Subjects ... " CASE u = 2 && " Locations ... " CASE u = 3 && " Today & Tomorrow " CASE u = 4 && " This Week " CASE u = 5 && " This Month " CASE u = 6 && " Select Date ... " ENDCASE IF c $ dstr dstr = Stuff(dstr,a,1,"m") SET COLOR TO W/W @ a+1,18 SAY " " ELSE dstr = Stuff(dstr,a,1,c) SET COLOR TO W+/W @ a+1,18 SAY "√" ENDIF CASE m = 5 && Help CASE m = 6 && Quit QUIT ENDCASE OTHERWISE LOOP ENDCASE ENDDO ENDDO QUIT ************************************************** PROCEDURE pBox PARAMETERS s DO CASE CASE s = 1 && View DO BoxW WITH 1,3,5,15,"s" @ 3,4 SAY " Slideshow " @ 4,4 SAY " Reviews " SET COLOR TO W+/N @ 2,4 SAY " Events " CASE s = 2 && Find DO BoxW WITH 1,15,7,26,"s" @ 3,16 SAY " Event " @ 4,16 SAY " Schedule " @ 5,16 SAY " Review " @ 6,16 SAY " Archive " SET COLOR TO W+/N @ 2,16 SAY " Poster " CASE s = 3 && Add/Cancel DO BoxW WITH 1,23,6,42,"s" @ 3,24 SAY " Cancel Event ... " @ 4,24 SAY " Upload Schedule " @ 5,24 SAY " Upload Poster " SET COLOR TO W+/N @ 2,24 SAY " Add Event ... " CASE s = 4 && Setup DO BoxW WITH 1,34,8,53,"s" @ 3,35 SAY " Locations ... " @ 4,35 SAY " Today & Tomorrow " @ 5,35 SAY " This Week " @ 6,35 SAY " This Month " @ 7,35 SAY " Select Date ... " SET COLOR TO W+/N @ 2,35 SAY " Subjects ... " ENDCASE RETURN ************************************************** PROCEDURE BoxW PARAMETERS m,y,n,c,s SET COLOR TO W/W @ m,y CLEAR TO n,c IF "s" $ s SET COLOR TO N/N @ n+1,y+1 CLEAR TO n+1,c @ m+1,c+1 CLEAR TO n+1,c+1 ENDIF SET COLOR TO N/W IF "+" $ s SET COLOR TO W+/W ENDIF @ m,y SAY "┌" @ m,y+1 TO m,c @ m,c SAY "┐" @ m+1,y TO n,y @ n,y SAY "└" IF "a" $ s SET COLOR TO W+/W @ n-1,Ceiling((c-y-11)/2)+y SAY "< ANY KEY >" ENDIF SET COLOR TO N/W @ m+1,c TO n,c @ n,y+1 TO n,c @ n,c SAY "┘" RETURN ************************************************** PROCEDURE clrB PARAMETERS n SET COLOR TO B/B DO CASE CASE n = 1 @ 1,3 CLEAR TO 6,16 CASE n = 2 @ 1,15 CLEAR TO 8,27 CASE n = 3 @ 1,23 CLEAR TO 7,43 CASE n = 4 @ 1,34 CLEAR TO 9,54 ENDCASE RETURN ************************************************** PROCEDURE Msg PARAMETERS ms DO CASE CASE ms = 1 mg = "? = Help <Ctrl>+<End> = Save <Esc> = Quit without Saving " CASE ms = 2 mg = "? = Help <Enter> = Quit, use selected Event Type " CASE ms = 3 mg = "? = Help <Enter> = Done │ Upload a full screen text/ANSI ad " CASE ms = 4 mg = "? = Help <Enter> = Done <Space Bar> = Select topic " CASE ms = 11 mg = "? = Help │ Display all Events matching setup parameters " CASE ms = 12 mg = "? = Help │ Display all Poster Ads matching setup parameters " CASE ms = 13 mg = "? = Help │ Display all Reviews matching setup parameters " CASE ms = 21 mg = "? = Help │ Find Ads matching Location/Date/Subject parameters " CASE ms = 22 mg = "? = Help │ Find Events matching Location/Date/Subject parameters " CASE ms = 23 mg = "? = Help │ Find Schedules for Subjects in Setup " CASE ms = 24 mg = "? = Help │ Find Review matching Location/Date/Subject parameters " CASE ms = 25 mg = "? = Help │ Download Event Archive for specified date " CASE ms = 31 mg = "? = Help │ Add Special, Weekly, or Monthly Event " CASE ms = 32 mg = "? = Help │ Stop display of a cancelled Event " CASE ms = 33 mg = "? = Help │ Send sports/events schedule to BBS " CASE ms = 34 mg = "? = Help │ Upload ad for your event " CASE ms = 41 mg = "? = Help │ Select Subjects for Search / View " CASE ms = 42 mg = "? = Help │ Select Locations for Search / View " CASE ms = 43 mg = "? = Help │ Search/View Today's and Tomorrow's Events " CASE ms = 44 mg = "? = Help │ Search/View next 7 days' Events " CASE ms = 45 mg = "? = Help │ Search/View next 30 days' Events " CASE ms = 46 mg = "? = Help │ Select one date for Search/View " CASE ms = 51 mg = "Display Full Help Text │ ? for Context-sensitive Help " CASE ms = 61 mg = "Exit Event Master, return to BBS menu " ENDCASE SET COLOR TO N/W @ 23,1 SAY mg RETURN ************************************************** PROCEDURE Ckae PARAMETERS ae SET COLOR TO W+/W DO CASE CASE ae = 1 @ 11,33 SAY "■" @ 12,33 SAY " " @ 13,33 SAY " " CASE ae = 2 @ 11,33 SAY " " @ 12,33 SAY "■" @ 13,33 SAY " " CASE ae = 3 @ 11,33 SAY " " @ 12,33 SAY " " @ 13,33 SAY "■" ENDCASE RETURN ************************************************** PROCEDURE tBoard PARAMETERS p,sstr PRIVATE r PRIVATE c SET COLOR TO GR+/B @ 4,63 SAY LTrim(Str(p+1)) SET COLOR TO N/W FOPEN sub SUBJECT.SUB 10 buf FSEEK sub z (p*702) 0 x = 1 r = 6 c = 13 DO WHILE x <= 26 FLREAD sub z line line = CRTrim(line) IF "@@@@" $ line line = Replicate(Chr(32),25) DO WHILE x <= 26 @ r,(c-3) SAY " " @ r,c SAY line x = x + 1 r = r + 1 IF x = 14 r = 6 c = 43 ENDIF ENDDO EXIT ENDIF Sarray[x] = line @ r,c SAY line IF c = 13 i = (r-5)+(p*26) ELSE i = (r-5)+13+(p*26) ENDIF @ r,(c-3) SAY SubStr(sstr,i,1) r = r + 1 x = x + 1 IF x = 14 r = 6 c = 43 ENDIF ENDDO FCLOSE sub RETURN ************************************************** PROCEDURE NewDbf APPEND BLANK REPLACE sth WITH 0, eth WITH 0, ca WITH 0, cu WITH 0, cc WITH 0 REPLACE stm WITH "00", etm WITH "00" REPLACE sap WITH "p", eap WITH "p" REPLACE stat WITH "..", phn WITH ".............." REPLACE ev WITH Replicate(".",35), loc WITH Replicate(".",35) REPLACE dsc1 WITH Replicate(Chr(32),43), dsc2 WITH Replicate(Chr(32),43) REPLACE cty WITH "................" DO BoxW WITH 3,10,19,70,"s" @ 6,12 SAY "Event [ ]" @ 9,12 SAY "Start Time: .m. End Time: .m." @ 11,12 SAY "Location [ ]" @ 12,12 SAY "City [ ] State [ ]" @ 13,12 SAY "Description [ ]" @ 14,24 SAY "[ ]" @ 16,12 SAY "COST: Adult $ Under 12 $ Child $" @ 18,12 SAY "Information phone number" DO Msg WITH 1 RETURN ************************************************** PROCEDURE Screen SET COLOR TO B/B @ 0,0 CLEAR SET COLOR TO W/W @ 0,0 CLEAR TO 0,79 @ 24,0 CLEAR TO 24,79 SET COLOR TO N/W @ 0,4 SAY " View " @ 0,17 SAY " Find " @ 0,29 SAY " Add/Cancel " @ 0,59 SAY " Help " @ 0,71 SAY " Quit " SET COLOR TO W/N @ 0,46 SAY " Setup " RETURN ************************************************** PROCEDURE Popup PARAMETERS nx,bx,xx PRIVATE n n = Date()+(nx-1) @ 3,25 SAY cDoW(n) + " " + cMonth(n) + " " + LTrim(Str(Day(n))) + ", " + LTrim(Str(Year(n))) dnd = HomePath() + "DAY\" + SubStr(DtoC(n),1,2) + SubStr(DtoC(n),4,2) + SubStr(DtoC(n),7,2) + ".DAY" FOPEN day &dnd 10 buf IF bx = 0 FSEEK day z 0 2 IF z > 314 FSEEK day z -314 bx = z ELSE FCLOSE day xx = 0 RETURN ENDIF ELSE FSEEK day z bx 0 ENDIF FLREAD day z line IF "@@@@" $ line FCLOSE day xx = 3 RETURN ENDIF IF SubStr(sstr,Val(SubStr(line,1,3)),1) = "X" SET COLOR TO W+/W @ 7,14 SAY SubStr(line,34,25) @ 9,14 SAY SubStr(line,59,43) @ 10,14 SAY SubStr(line,102,43) FLREAD day z line FCLOSE @ 5,14 SAY SubStr(line,121,10) + " to " + SubStr(line,131,10) @ 8,14 SAY SubStr(line,1,35) @ 12,14 SAY SubStr(line,36,35) + " " + RTrim(SubStr(line,71,16)) + "," + SubStr(line,87,2) @ 14,14 SAY SubStr(line,102,7) @ 15,16 SAY SubStr(line,109,6) @ 15,43 SAY SubStr(line,115,6) @ 17,18 SAY SubStr(line,89,13) ELSE FCLOSE xx = 2 bx = bx + 288 RETURN ENDIF IF "." $ SubStr(line,141,12) SET COLOR TO N/W @ 21,6 CLEAR TO 21,40 @ 21,8 SAY "More info available. View Now?" ENDIF xx = 1 bx = bx + 288 RETURN